unit XmlParser ;

{$B-}

{
  Grammar
  -------

  We will not be able to parse all XML documents. In particular, we will ignore
  DTDs, attributes, the contents of a prolog, escaped characters (eg &lt;) and
  empty element tags (eg <NothingHere/>. We will be able to cope with empty
  files, though.

  In this BNF, '?' is a character, not the representation of an empty string,
  for which we will use 'e'

  * = zero or more (Kleene closure)
  + = 1 or more (positive closure)
  ^ = 0 or 1 (use superscript 0..1 in article)

  XmlDoc     -> Prolog^ TagList^
  Prolog     -> <?xml PrologData?>
  TagList    -> Node*
  Node       -> StartTag [Data | TagList] EndTag
  StartTag   -> <TagName>
  EndTag     -> </TagName>
  PrologData -> [Any printable characters except <,>,/ and ? ]*
  Data       -> [Any printable characters except <,> and / ]*
  TagName    -> [Any printable characters except <,>,/,space,?]+
}

interface

uses
   SysUtils,
   Classes,
   XmlInterpreter ;

const
   // Token types are the characters 0 to 255, along with the following
   ttEndOfDoc       = -1 ;

type
   TXmlToken = class( TObject )
   private
      FTokenType : Integer ;
      FAsString : string ;
   public
      property TokenType : Integer read FTokenType write FTokenType ;
      property AsString : string read FAsString write FAsString ;
   end ;

   TXmlLexicalAnalyser = class( TObject )
   private
      FText : string ;
      FPosition : Integer ;

      procedure SetText( const Value : string ) ;
   public
      procedure GetNextToken( NextToken : TXmlToken ) ;
      procedure RollBack( Token : TXmlToken ) ;

      property Text : string read FText write SetText ;
      property Position : Integer read FPosition ;
   end ;

   TXmlParser = class( TObject )
   private
      FLookahead : TXmlToken ;
      FLexAnalyser : TXmlLexicalAnalyser ;
      FLastTag : string ;

      procedure Match( T : Integer ) ; overload ;
      procedure Match( Ch : Char ) ; overload ;
      procedure RollBack ;
      function FollowSymbol : string ;
      procedure ConsumeWhiteSpace ;
      procedure XmlDoc( Exp : TXmlDoc ) ;
      procedure Prolog( Exp : TXmlDoc ) ;
      procedure TagList( Exp : TXmlDoc ) ; overload ;
      procedure TagList( Exp : TXmlNode ) ; overload ;
      procedure Node( Exp : TXmlTagList ) ;
      procedure StartTag( Exp : TXmlNode ) ;
      procedure EndTag( Exp : TXmlNode ) ;
      function PrologData : string ;
      function Data : string ;
      function TagName : string ;
   public
      constructor Create ;
      destructor Destroy ; override ;

      procedure Parse( const DocString : string ; ADoc : TXmlDoc ) ;
   end ;

   EXmlParserError = class( Exception ) ;

implementation

{ TXmlLexicalAnalyser }

procedure TXmlLexicalAnalyser.GetNextToken( NextToken : TXmlToken ) ;
begin
   // Read the next character
   if FPosition > Length( FText ) then begin
      // At the end of the document
      NextToken.AsString := #0 ;
      NextToken.TokenType := ttEndOfDoc ;
   end
   else begin
      // Return the character
      NextToken.AsString := FText[ FPosition ] ;
      NextToken.TokenType := Integer( FText[ FPosition ] ) ;
      Inc( FPosition ) ;
   end ;
end ;

procedure TXmlLexicalAnalyser.RollBack( Token : TXmlToken ) ;
begin
   if Position > 1 then begin
      Dec( FPosition ) ;
   end ;

   if Position > 1 then begin
      Token.AsString := FText[ FPosition - 1 ] ;
      Token.TokenType := Integer( FText[ FPosition - 1 ] ) ;
   end ;
end ;

procedure TXmlLexicalAnalyser.SetText( const Value : string ) ;
begin
   FPosition := 1 ;
   FText := Value ;
end ;

{ TXmlParser }

constructor TXmlParser.Create ;
begin
   inherited ;
   FLookahead := TXmlToken.Create ;
   FLexAnalyser := TXmlLexicalAnalyser.Create ;
end ;

destructor TXmlParser.Destroy ;
begin
   FLookahead.Free ;
   FLexAnalyser.Free ;
   inherited ;
end ;

procedure TXmlParser.Match( T : Integer ) ;
begin
   // If the token type T matches the FLookahead token type then FLookAhead is
   // set to the next token, otherwise an exception is raised
   if FLookahead.TokenType = T then begin
      FLexAnalyser.GetNextToken( FLookahead ) ;
   end
   else begin
      raise EXmlParserError.Create( Format( 'XML syntax error. Expected %s but got %s at %d',
         [ Char( T ), Char( FLookahead.TokenType ), FLexAnalyser.Position ] ) ) ;
   end ;
end ;

procedure TXmlParser.Match( Ch : Char ) ;
begin
   Match( Ord( Ch ) ) ;
end ;

procedure TXmlParser.RollBack ;
begin
   FLexAnalyser.RollBack( FLookahead ) ;
end ;

function TXmlParser.FollowSymbol : string ;
begin
   // Peek at symbol after the lookahead one
   Match( FLookahead.TokenType ) ;
   Result := FLookahead.AsString ;
   RollBack ;
end ;

procedure TXmlParser.ConsumeWhiteSpace ;
begin
   // Eats 'whitespace' ie chars 0 to 32 inclusive. Here instead of lexical
   // analyser because white space may be allowed sometimes.
   while ( FLookahead.TokenType <> ttEndOfDoc ) and
      ( FLookAhead.AsString <= ' ' ) do begin
      FLexAnalyser.GetNextToken( FLookAhead ) ;
   end ;
end ;

procedure TXmlParser.XmlDoc( Exp : TXmlDoc ) ;
begin
   // XmlDoc -> Prolog* TagList*
   ConsumeWhiteSpace ;

   if FLookahead.AsString = '<' then begin
      // Looking for either a Prolog or a TagList
      if FollowSymbol = '?' then begin
         Prolog( Exp ) ;
         ConsumeWhiteSpace ;
      end ;

      TagList( Exp ) ;
   end ;

   ConsumeWhiteSpace ;
   Match( ttEndOfDoc ) ;
end ;

procedure TXmlParser.Prolog( Exp : TXmlDoc ) ;
begin
   Exp.Prolog := TXmlProlog.Create ;
   // Prolog -> <?xml Data?>
   Match( '<' ) ;
   Match( '?' ) ;
   Match( 'x' ) ;
   Match( 'm' ) ;
   Match( 'l' ) ;
   ConsumeWhiteSpace ;
   Exp.Prolog.Data := PrologData ;
   Match( '?' ) ;
   Match( '>' ) ;
end ;

procedure TXmlParser.TagList( Exp : TXmlDoc ) ;
begin
   Exp.TagList := TXmlTagList.Create ;

   // TagList -> Node*
   while ( FLookahead.AsString = '<' ) and ( FollowSymbol <> '/' ) do begin
      Node( Exp.TagList ) ;
   end ;
end ;

procedure TXmlParser.TagList( Exp : TXmlNode ) ;
begin
   Exp.TagList := TXmlTagList.Create ;

   // TagList -> Node*
   while ( FLookahead.AsString = '<' ) and ( FollowSymbol <> '/' ) do begin
      Node( Exp.TagList ) ;
   end ;
end ;

procedure TXmlParser.Node( Exp : TXmlTagList ) ;
var
   TempNode         : TXmlNode ;
begin
   // Node -> StartTag [Data | TagList] EndTag
   // Check to see if this is a new start tag, or the end tag of the list
   TempNode := Exp.Add ;
   StartTag( TempNode ) ;
   ConsumeWhiteSpace ;

   if ( FLookahead.AsString = '<' ) and ( FollowSymbol <> '/' ) then begin
      // Have the start of another taglist
      TagList( TempNode ) ;
   end
   else begin
      // Have a data node, possibly empty
      TempNode.Data := Data ;
   end ;

   EndTag( TempNode ) ;
   ConsumeWhiteSpace ;
end ;

procedure TXmlParser.StartTag( Exp : TXmlNode ) ;
begin
   Exp.StartTag := TXmlStartTag.Create ;
   // StartTag -> <TagName>
   Match( '<' ) ;
   Exp.StartTag.TagName := TagName ;
   Match( '>' ) ;
end ;

procedure TXmlParser.EndTag( Exp : TXmlNode ) ;
begin
   Exp.EndTag := TXmlEndTag.Create ;
   // EndTag -> </TagName>
   Match( '<' ) ;
   Match( '/' ) ;
   Exp.EndTag.TagName := TagName ;
   Match( '>' ) ;
end ;

function TXmlParser.PrologData : string ;
begin
   Result := '' ;

   // Data -> [Any printable characters except <,>,/ and ? ]*
   while not ( FLookahead.TokenType in [ 0..31, Ord( '<' ), Ord( '>' ), Ord( '/' ), Ord( '?' ) ] ) do begin
      Result := Result + FLookahead.AsString ;
      Match( FLookahead.TokenType ) ;
   end ;
end ;

function TXmlParser.Data : string ;
begin
   Result := '' ;

   // Data -> [Any printable characters except <,> and / ]*
   while not ( FLookahead.TokenType in [ 0..31, Ord( '<' ), Ord( '>' ), Ord( '/' ) ] ) do begin
      Result := Result + FLookahead.AsString ;
      Match( FLookahead.TokenType ) ;
   end ;
end ;

function TXmlParser.TagName : string ;
begin
   Result := '' ;

   // TagName  -> [Any printable characters except <,>,/,space]+
   while not ( FLookahead.TokenType in [ 0..32, Ord( '<' ), Ord( '>' ), Ord( '/' ) ] ) do begin
      Result := Result + FLookahead.AsString ;
      Match( FLookahead.TokenType ) ;
   end ;
end ;

procedure TXmlParser.Parse( const DocString : string ; ADoc : TXmlDoc ) ;
begin
   ADoc.Clear ;

   if DocString = '' then begin
      // Nothing to parse
      Exit ;
   end ;

   FLastTag := '' ;
   FLexAnalyser.Text := DocString ;
   FLexAnalyser.GetNextToken( FLookahead ) ;
   XmlDoc( ADoc ) ;
end ;

end.

